(defun pv-print-matrix-to-window (a window-object &key row-labels column-labels types variable-types var-types (row-heading "Observations") (column-heading "Variables") col-heading labels  col-labels (decimals 2) (show t) )
"Args: (matrix window-object &key (decimals 2) row-labels column-labels row-heading column-heading var-types types show print)
Displays MATRIX in WINDOW-OBJECT in a nice format with DECIMALS places after the decimal. Does not show window when SHOW is NIL. Displays row labels when the :ROW-LABELS (or :LABELS) keyword is followed by a list of labels. Displays  column labels when the :COLUMN-LABELS (or :COL-LABELS) keyword is followed by a list of labels. Displays row and column headings when :ROW-HEADING and :COLUMN-HEADING (or :COL-HEADING) are used. When column labels are displays, also displays variable types when :VARIABLE-TYPES (or :VAR-TYPES OR :TYPES) is followed by a list of variable type strings. Modified by FWY from LT's print-matrix function. Modified from Forrest's so the row labels are shown entirely, not chopped."
  (unless (matrixp a) (error "not a matrix - ~a" a)) 
  (let ((size 0)
        (sizea 0)
        (sizes (array-dimensions a))
        (j 0)
        (n)
        (y) (maxcol 0) (column)
        (min-col-label-length 4)
        (row-label-length)
        (col-label-length)
        (field-width)
        (buffer)) 
    (when (not window-object)
          (setf window-object (report-header "Print Matrix" :page t :show show)))
    (when (and (not row-labels) (not labels))
          (setf row-labels (mapcar #'(lambda (i) (format nil "Obs ~a" i)) 
                                   (1+ (iseq (first sizes))))))
    (when (and (not col-labels) (not column-labels))
          (setf col-labels (mapcar #'(lambda (i) (format nil "Var ~a" i)) 
                                   (1+ (iseq (second sizes))))))
    (when row-labels (setf labels row-labels))
    (when column-labels (setf col-labels column-labels))
    (when var-types (setf variable-types var-types))
    (when types (setf variable-types types))
    (when variable-types (setf min-col-label-length 8))
    (dotimes (i (length (row a 0)))
             (setf column (non-missing (col a i)));PV added (non-missing
             (cond 
               ((not (stringp (select column 0)))
                (setf maxcol (max maxcol (abs column)))
                (setf size (max size (+ 4 (flatsize (round (max (abs column))))))))
               (t
                (setf sizea (max (mapcar #'length (coerce column 'list)))))))
    (setf size (max size sizea))
    (setf maxcol (max maxcol sizea))
    (if (and (/= maxcol 0)(< maxcol 10)) (setf size (1+ size)))
    (setf decimals+size  (max (+ decimals size) min-col-label-length))
    (setf decimals+sizea decimals+size)
    (setf iseq!decimals+size (iseq decimals+size))
    (setf row-heading (select (strcat row-heading (make-string 12)) (iseq 12)))
    (when labels
          (setf row-label-length (max (list 12 (max (mapcar #'length labels)))))
          (setf labels
                (mapcar #'(lambda (label)
                            (setf label (strcat label (make-string row-label-length)))
                            (setf label (select label (iseq row-label-length))))
                        labels)))
    (setf buffer (right-justify-string 
                  (string-upcase column-heading)
                  (+ decimals+size 14
                     (- (length column-heading)
                        (length (first col-labels))))))
    (send window-object :paste-string buffer)
    (send window-object :paste-string (format nil "~%"))
    (when row-labels 
          (if (not variable-types)
              (setf buffer 
                    (strcat ;(format nil "~%") 
                            (string-upcase row-heading) 
                            (make-string (- row-label-length 12))))
              (setf buffer "              "))
          (mapcar #'(lambda (label)
                      (setf buffer (strcat buffer 
                        (format nil "~a " (right-justify-string
                                           label decimals+size)))))
                  col-labels)
          (send window-object :paste-string buffer))


    (when variable-types 
          (setf buffer 
                    (strcat (format nil "~%") 
                            (string-upcase row-heading) 
                            (make-string (- row-label-length 12)))))
    (when col-labels
          (setf col-label-length 14)
          (when variable-types
                (format nil "~%")
                (mapcar #'(lambda (type)
                            (setf buffer (strcat buffer 
                              (format nil "~a " (right-justify-string 
                                                 type decimals+size)))))
                        variable-types)
                (send window-object :paste-string buffer)))
    (setf buffer (format nil "~%"))
    (send window-object :paste-string buffer)
    (dolist (x (row-list a))
            (setf n (length x))
            (setf buffer "")
            (when (not (equal labels nil))
                  (if window-object (setf buffer (strcat buffer 
                              (format nil "~a" (select labels j))))
                      (format t "~a" (select labels j)))
                  (setf j (1+ j)))
            (dotimes (i n)
                     (setf y (aref x i))
                     (cond
                       ((integerp y)
                        (if window-object
                            (setf buffer (strcat buffer 
                                 (format nil "~vd" (+ decimals size) y )))
                            (format t "~vd" (+ decimals size) y)))
                       ((floatp y)
                        (if window-object
                            (setf buffer (strcat buffer 
                                  (format nil "~v,vf" (+ decimals size) decimals y)))
                            (format t "~v,vf" (+ decimals size)
                                    decimals y)))
                       (t 
                        (if window-object
                            (setf buffer (strcat buffer 
                               (format nil "~va" (+ decimals sizea) 
                                 (reverse (select 
                                   (reverse (strcat (make-string decimals+size) y))
                                           iseq!decimals+size)))))
                            (format t "~va" decimals+sizea 
                                    y))))
                     (if (< i (- n 1))
                         (if window-object
                             (setf buffer (strcat buffer (format nil " ")))
                             (format t " ")))
                     )
            (if window-object (send window-object :paste-string buffer))
        
            (if window-object
                (send window-object :paste-string (format nil "~%"))
                (format t "~%")))
    window-object))